home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Graphics Plus
/
Graphics Plus.iso
/
msdos
/
plotting
/
rcdsplay
/
grafed.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-05-25
|
52KB
|
1,233 lines
{*************************************************************************
TITLE : GRAFED
VERSION : 2.1
AUTHOR : Roger Carlson (after GRAFED5, version 3.2 of M.Riebe and
R.Carlson written for the IBM CS9000 computer) 5/29/90
FUNCTION: This unit contains the GRAF routine for interactive display of
xy data.
INPUTS : DATA - The xy data. The first index identifies x(1) or y(2)
and the second index specifies the data point.
FILENAME - Name of the data file.
MINX - Minimum x value.
MAXX - Maximum x value.
LOY - Smallest y value.
HIY - Largest y value.
NUMPTS - Number of data points.
NOTES : 1. In Turbo Pascal the maximum size of any variable is 64KB.
To use the largest possible data array sizes, I've used
a single precision data array, which uses 23 bit (7-8digit)
precision.
CHANGES : 6/2/90 (1.1,RJC) - Added window selection.
6/3/90 (1.2,RJC) - Modified to change passed parameters to
include x max and min rather than first and last index.
6/4/90 (1.3,RJC) - Added parameter window at bottom of screen.
6/12/90 (1.4,RJC) -Added crosshair, ruler and several bells and
whistles.
7/6/90 (1.5,RJC) - Started some bells and whistles. Moved
CLRBOX to AXISLBL.
3/23/91 (1.6,RJC) -Increased the maximum data array size to
7000 and changed data array type to single precision. Also
changed screen driver path to d:\tp to be consistent with
lab computer setup.
3/28/91 (1.7,RJC) -Added peak integration routine and completed
the moving average option.
5/2/91 (1.8,RJC) - Corrected text file dump procedure to include
data filtering.
5/3/91 (1.9,RJC) - Added linear transformation of axes,
wavelength/wavenumber conversion of x axis, and change of
axis labels.
5/9/91 (2.0,RJC) - Added postscript print screen procedure,
user defined window bounds, pan left, pan right, expand
horizontally, dos shell command, and crosshair trace mode.
5/23/91 (2.1,RJC) - Corrected an array range error when the
newmode flag was set (eg for a linear transform of x). Added
min/max procedure and nonlinear transforms.
*************************************************************************}
UNIT GRAFED;
{$I-} {Disable IO checking.}
INTERFACE
USES IOFUNCS; {version 1.7}
CONST MAXPTS=7000; {Maximum # of data points.}
TYPE DARRAY=ARRAY[1..2,1..MAXPTS] OF SINGLE;
PROCEDURE GRAF(VAR DATA:DARRAY; FILENAME:STR20; MINX,MAXX,LOY,HIY:REAL;
NUMPTS:INTEGER);
IMPLEMENTATION
USES CRT,GRAPH,DOS,
MATH, {VERSION 1.3}
AXISLBL; {VERSION 2.6}
PROCEDURE GRAF;
CONST
DRIVERS='d:\tp'; {location of device drivers}
SCRLEFT=100; {plot starts SCRLEFT units from left edge}
SCRBOTTOM=58; {bottom of plot SCRBOTTOM units from screen bottom}
SCRTOP=28; {top of plot SCRTOP unit from screen top}
LINE1=3; {first line for window at top of screen}
LINE2=13; {second line for window at top of screen}
VAR
ASCII : INTEGER; {ordinal value of a key pressed}
BWBSC : integer; {bottom window boundary in screen coordinates}
BWBUC : REAL; {bottom window bound in user coordinates}
CHFLAG : BOOLEAN; {turns crosshair display on}
CHSENS : INTEGER; {crosshair movement sensitivity}
CHXUC,CHYUC : REAL; {crosshair user coordinates}
CHXSC,CHYSC : INTEGER; {crosshair screen coordinates}
DONEFLAG : BOOLEAN; {flag to bet out of program}
ELIPSFLAG : BOOLEAN; {flags circling of each point}
ERRCODE : integer; {error code}
FILTYPE,
FILDEGREE,
FILDERIV,
FILWIDTH : INTEGER; {filter parameters}
FIRST : INTEGER; {index of current first displayed point}
FRAME : BOOLEAN; {flags need to redraw frame}
GRAPHDRIVER : integer; {graphics device ID number}
GRAPHMODE : integer; {mode for the graphics device}
HIXUC : REAL; {highest x user coordinate}
kbdbox : viewporttype; {graphics window at bottom of screen}
LAST : INTEGER; {index of last point currently displayed}
LINEFLAG : BOOLEAN; {flags connecting of points with lines}
LINFLAG : BOOLEAN; {flag to indicate choice of movable line}
LINLEN : INTEGER; {length of line in number of pixels}
LINXSC,LINYSC: INTEGER; {line screen coordinates}
LINXUC,LINYUC: REAL; {line user coordinates}
LOXUC : REAL; {lowest x value in user coordinates}
LWBIC : INTEGER; {lefg window boundary in index coordinates}
LWBSC : integer; {left window boundary in screen coordinates}
LWBUC : REAL; {left window boundary in user coordinate}
NEWMODE : BOOLEAN; {flags choice of a new display mode}
OLDBWBUC : REAL; {temporary bottom window bound in user coords}
OLDLWBUC : REAL; {temporary left window bound in user coords}
REDRAW : BOOLEAN; {flags need to redraw the screen plot}
RWBIC : INTEGER; {rigth window boundary in index coordinates}
RWBSC : integer; {right window boundary in screen coordinates}
RWBUC : REAL; {right window boundary in user coordinate}
SCANCODE : INTEGER; {extended code for a key pressed}
STEPSIZE : INTEGER; {size of increments between points}
THETA : REAL; {angle of live vs. horizontal (radians)}
TRACE : BOOLEAN; {flags crosshair trace mode}
TWBSC : integer; {top window boundary in screen coordinates}
TWBUC : REAL; {top window boundary in user coordinates}
titlebox : viewporttype; {graphics window at top of screen}
WINDSENS : INTEGER; {window movement sensitivity}
XLABEL : STR40; {label for x axis}
YLABEL : STR40; {label for y axis}
{************************ Coordinate Transformations ********************}
FUNCTION XCOORDSC(DATAPT:REAL):INTEGER; BEGIN
{Returns x value in screen coordinates corresponding to the user
value DATAPT by comparing it to the left and right window boundaries
in user coordinates.}
XCOORDSC:=ROUND((DATAPT-LWBUC)*((RWBSC-LWBSC)/(RWBUC-LWBUC))+LWBSC);
END; {XCOORDSC}
FUNCTION XDATAVAL(INDEX:INTEGER):REAL;
{Returns x coordinate value in user specified units for a given index
with user specified slope and intercept incorporated.}
BEGIN
IF (INDEX>=1) AND (INDEX<=NUMPTS) THEN XDATAVAL:=DATA[1,INDEX]
ELSE XDATAVAL:=(INDEX-1)*(DATA[1,NUMPTS]-DATA[1,1])/(NUMPTS-1)+DATA[1,1]
END; {XDATAVAL}
FUNCTION YCOORDSC(DATAPT:REAL):INTEGER; BEGIN
{Returns y value in screen coordinates corresponding to the supplied
user coordinate of the current point by comparing it to the top and
bottom displayed user coordinates.}
YCOORDSC:=ROUND((DATAPT-BWBUC)*((TWBSC-BWBSC)/(TWBUC-BWBUC))+BWBSC);
END; {YCOORDSC}
FUNCTION XCOORDUC(DATAPT:REAL):REAL; BEGIN
{Returns the x value in user coordinates corresponding to the supplied
screen coordinate of a point.}
XCOORDUC:=(DATAPT-LWBSC)*(RWBUC-LWBUC)/(RWBSC-LWBSC)+LWBUC;
END;
FUNCTION YCOORDUC(DATAPT:REAL):REAL; BEGIN
{Returns the y value in user coordinates corresponding to the suppied
screen coordinate of a point.}
YCOORDUC:=(DATAPT-BWBSC)*(TWBUC-BWBUC)/(TWBSC-BWBSC)+BWBUC;
END;
FUNCTION YDATAVAL(INDEX:INTEGER):REAL;
{Returns y coordinate value in specified units for a given index to
the data array.}
VAR TEMPINDEX:INTEGER;
BEGIN
IF INDEX>LAST THEN TEMPINDEX:=LAST
ELSE IF INDEX<FIRST THEN TEMPINDEX:=FIRST
ELSE TEMPINDEX:=INDEX;
IF TEMPINDEX<=1 THEN TEMPINDEX:=1;
IF TEMPINDEX>=NUMPTS THEN TEMPINDEX:=NUMPTS;
YDATAVAL:=DATA[2,TEMPINDEX];
END; {YDATAVAL}
{********************* FUNCTION FILTER **********************************}
FUNCTION filter(FILDERIV,INDEX:INTEGER):REAL;
{This function applies either a moving average or Savitzky-Golay polynomial
fit least squares filter to the data using the following parameters:
FILTYPE : INTEGER 0=moving average, 1=Savitzy-Golay
FILDEGREE: INTEGER Degree of polynomial fit (2,3,or 4)
FILDERIV : INTEGER Derivative desired (0,1,or 2)
FILWIDTH : INTEGER Width of filter in number of datapoints
INDEX : INTEGER Index to central data value in data array.}
VAR YAVG : DOUBLE;
I,M : INTEGER;
BEGIN
YAVG:=0.0; M:=FILWIDTH DIV 2;
case FILTYPE of
0: BEGIN
for I:=(INDEX-M) to (INDEX+M) do YAVG:=YAVG+ydataval(I);
FILTER := YAVG/(2*M + 1);
END;
1: BEGIN
FILTER := YDATAVAL(I);
END;
END; {case}
END; {filter}
{************************** PROCEDURE SETCHY ******************************}
PROCEDURE SETCHY;
{Sets crosshair y screen coordinate to a point on the displayed data.}
VAR I,Y,MAXY:INTEGER; DONE:BOOLEAN;
BEGIN
I:=0; MAXY:=GETMAXY-SCRBOTTOM; DONE:=FALSE;
REPEAT
Y:=CHYSC+I;
IF (Y<MAXY) AND (GETPIXEL(CHXSC,Y)<>0) THEN BEGIN
DONE:=TRUE; CHYSC:=Y
END
ELSE BEGIN
Y:=CHYSC-I;
IF (Y>SCRTOP) AND (GETPIXEL(CHXSC,Y)<>0) THEN BEGIN
DONE:=TRUE; CHYSC:=Y
END;
END;
I:=I+1;
UNTIL DONE OR (I=MAXY-SCRTOP+1);
END;
{************************** PROCEDURE DRAWCH ******************************}
PROCEDURE DRAWCH;
{Draws or erases the crosshair at the coordinates CHXSC and CHYSC and
lists or erases coordinates at the top of the screen. The procedure
returns CHXUC and CHYUC.}
CONST HEIGHT=21;
VAR CHXLO,CHXHI,CHYLO,CHYHI,CHXLEN,CHYLEN : INTEGER;
ORXUC,ORYUC :REAL;
X,Y:STR20;
BEGIN
CHXLEN:=ROUND((GETMAXX-SCRLEFT)/25);
CHYLEN:=ROUND((GETMAXY-SCRBOTTOM-SCRTOP)/20);
IF ((CHXSC-CHXLEN)<LWBSC) THEN CHXLO:=LWBSC ELSE CHXLO:=CHXSC-CHXLEN;
IF ((CHXSC+CHXLEN)>RWBSC) THEN CHXHI:=RWBSC ELSE CHXHI:=CHXSC+CHXLEN;
IF ((CHYSC-CHYLEN)<TWBSC) THEN CHYLO:=TWBSC ELSE CHYLO:=CHYSC-CHYLEN;
IF ((CHYSC+CHYLEN)>BWBSC) THEN CHYHI:=BWBSC ELSE CHYHI:=CHYSC+CHYLEN;
{update crosshair user coordinates}
CHXUC:=XCOORDUC(CHXSC); CHYUC:=YCOORDUC(CHYSC);
LINE(CHXLO,CHYSC,CHXHI,CHYSC); LINE(CHXSC,CHYLO,CHXSC,CHYHI);
IF CHFLAG THEN BEGIN {diplay coords at top}
CLRBOX(0,0,GETMAXX,HEIGHT,FALSE);
SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
IF LINFLAG THEN BEGIN
STR((CHXUC-LINXUC):10:4,X); STR((CHYUC-LINYUC):10:4,Y);
OUTTEXTXY(3,4,CONCAT('Crosshair Relative Coordinates: ',
X,',',Y));
STR(ABS(XCOORDUC(LINXSC+ROUND(LINLEN/2*COS(THETA)))-
XCOORDUC(LINXSC-ROUND(LINLEN/2*COS(THETA)))):10:4,X);
STR(ABS(YCOORDUC(LINYSC+ROUND(LINLEN/2*SIN(THETA)))-
YCOORDUC(LINYSC-ROUND(LINLEN/2*SIN(THETA)))):10:4,Y);
OUTTEXTXY(3,13,CONCAT(' Line Length: ',X,',',Y));
END
ELSE BEGIN
STR(CHXUC:10:4,X); STR(CHYUC:10:4,Y);
OUTTEXTXY(3,4,CONCAT('Crosshair Absolute Coordinates: ',X,',',Y));
END
END
ELSE BEGIN {erase the top box}
SETVIEWPORT(0,0,GETMAXX,HEIGHT,CLIPON); CLEARVIEWPORT;
SETVIEWPORT(0,0,GETMAXX,GETMAXY,CLIPON);
END;
END; {DRAWCH}
{************************* PROCEDURE DRAWLN ********************************}
PROCEDURE DRAWLN;
{This procedure draws a translatable, rotatable lin on the screen for use
in conjunction with the crosshair in determining peak heights and widths.
The position is determined by LINXSC and LINYSC and the procedure returns
LINXUC and LINYUC.}
PROCEDURE RANGE(VAR NUMBER:INTEGER; R1,R2:INTEGER);
VAR MAX,MIN:INTEGER;
BEGIN
IF R1>R2 THEN BEGIN MAX:=R1; MIN:=R2; END
ELSE BEGIN MAX:=R2; MIN:=R1; END;
IF NUMBER<MIN THEN NUMBER:=MIN ELSE IF NUMBER>MAX THEN NUMBER:=MAX;
END; {RANGE}
PROCEDURE DOLINE(LINLEN:INTEGER; THETA:REAL);
VAR LX,LY,RX,RY: INTEGER;
BEGIN
LX:=LINXSC-ROUND(LINLEN/2*COS(THETA));
LY:=LINYSC-ROUND(LINLEN/2*SIN(THETA));
RX:=LINXSC+ROUND(LINLEN/2*COS(THETA));
RY:=LINYSC+ROUND(LINLEN/2*SIN(THETA));
RANGE(LX,LWBSC,RWBSC); RANGE(RX,LWBSC,RWBSC);
RANGE(LY,TWBSC,BWBSC); RANGE(RY,TWBSC,BWBSC);
LINE(LX,LY,RX,RY);
END; {DOLINE}
BEGIN
DOLINE(LINLEN,THETA); DOLINE(4,THETA+PI/2);
{update the line coordinates}
LINXUC:=XCOORDUC(LINXSC); LINYUC:=YCOORDUC(LINYSC);
IF CHFLAG THEN BEGIN {update the relative crosshair coords}
DRAWCH; DRAWCH;
END;
END; {DRAWLN}
{************************* PROCEDURE INTEGRATE *****************************}
PROCEDURE INTEGRATE;
VAR
A :DOUBLE; {running total of areas}
ANS :CHAR;
I :INTEGER; {data point index}
LASTY :DOUBLE; {last y value}
LX :DOUBLE; {screen coordinates of left end of ruler}
N :INTEGER; {number of points}
RX :DOUBLE; {screen coordinates of right end of ruler}
S :DOUBLE; {std deviation}
ST :STRING[3]; {string for output message}
SUMY :DOUBLE; {sum of y}
SUMYY :DOUBLE; {sum of sqr(y)}
XSC :DOUBLE; {x screen coord}
Y :DOUBLE; {y value}
YSC :DOUBLE; {y screen coord}
BEGIN
SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
ANS:='A';
REPEAT
CLRBOX(0,0,GETMAXX,24,TRUE);
OUTTEXTXY(3,LINE1,'Integration procedure: ');
MOVETO(3,LINE2);
OUTTEXT(CONCAT('Absolute Y values or Relative to the ruler (A or R) [',
ANS,']? '));
GRDCHAR(ANS);
UNTIL ANS IN ['A','a','r','R'];
IF ANS='a' THEN ANS:='A'; IF ANS='r' THEN ANS:='R';
CLRBOX(0,0,GETMAXX,24,TRUE);
OUTTEXTXY(3,LINE1,'Integration in progress...');
I:=FIRST; A:=0.0; LASTY:=0.0; N:=0; SUMY:=0.0; SUMYY:=0.0;
LX:=LINXSC-ROUND(LINLEN/2*COS(THETA));
RX:=LINXSC+ROUND(LINLEN/2*COS(THETA));
REPEAT
XSC:=XCOORDSC(DATA[1,I]);
IF (XSC<=RX) AND (XSC>=LX) THEN BEGIN
N:=N+1;
IF ANS='R' THEN
Y:=FILTER(FILDERIV,I)-YCOORDUC(LINYSC+(XSC-LINXSC)*TAN(THETA))
ELSE Y:=FILTER(FILDERIV,I);
IF LASTY<>0.0 THEN A:=A+(LASTY+Y)*(XDATAVAL(I)-XDATAVAL(I-1));
SUMY:=SUMY+Y; SUMYY:=SUMYY+SQR(Y);
LASTY:=Y;
END; {IF}
I:=I+1;
UNTIL I>LAST;
S:=SQRT( (SUMYY-SQR(SUMY)/N)/(N-1) );
IF ANS='R' THEN ST:='Rel' ELSE ST:='Abs';
CLRBOX(0,0,GETMAXX,24,TRUE);
OUTTEXTXY(3,LINE1,CONCAT(ST,' Int=',RLTOSTR(A/2,12),' over: ',
RLTOSTR(xcoorduc(lx),14),' to ',
RLTOSTR(xcoorduc(rx),14) ));
MOVETO(3,LINE2);
OUTTEXT(CONCAT(ST,' <Y>=',RLTOSTR(sumy/n,12),'(',CHAR(241),
RLTOSTR(s*t(n-1)/sqrt(n),12),') Std Dev =',
RLTOSTR(s,12)));
END; {PROCEDURE INTEGRATE}
{************************* PROCEDURE LIMITS ********************************}
PROCEDURE LIMITS(LOXUC,HIXUC:REAL; VAR FIRST,LAST,LWBIC,RWBIC:INTEGER);
{This procedure calculates FIRST and LAST appropriate for the given user
coordinate window boundaries. It also returns new values of LWBIC and
RWBIC.}
VAR
X1,X2 : REAL; {user coordinates of old first & last points}
LEFT : BOOLEAN; {T=first on left, F=first on right}
F,L : INTEGER; {temporary values of FIRST and LAST}
OVERF,OVERL : BOOLEAN; {flag for window boundaries outside of data extents}
BEGIN
OVERF:=FALSE; OVERL:=FALSE; X1:=XDATAVAL(FIRST); X2:=XDATAVAL(LAST);
LEFT:=(X2-X1)/(RWBUC-LWBUC)>0;
{calculate approximate values by linear interpolation}
IF LEFT THEN BEGIN
F:=FIRST + ROUND((LWBUC-X1)/(X2-X1)*(LAST-FIRST)) - 1;
L:=FIRST + ROUND((RWBUC-X1)/(X2-X1)*(LAST-FIRST)) + 1;
END
ELSE BEGIN
F:=FIRST + ROUND((RWBUC-X1)/(X2-X1)*(LAST-FIRST)) - 1;
L:=FIRST + ROUND((LWBUC-X1)/(X2-X1)*(LAST-FIRST)) + 1;
END;
IF F<1 THEN BEGIN FIRST:=1; OVERF:=TRUE; END;
IF F>NUMPTS THEN BEGIN FIRST:=NUMPTS; OVERF:=TRUE; END;
IF L>NUMPTS THEN BEGIN LAST:=NUMPTS; OVERL:=TRUE; END;
IF L<1 THEN BEGIN LAST:=1; OVERL:=TRUE; END;
{make sure values are not too far inside desired boundaries}
IF NOT(OVERF) THEN WHILE (XDATAVAL(F)<HIXUC) AND (XDATAVAL(F)>LOXUC)
AND (L>F) AND (F>=2) DO F:=F-1;
IF NOT(OVERL) THEN WHILE (XDATAVAL(L)<HIXUC) AND (XDATAVAL(L)>LOXUC)
AND (L>F) AND (L<=(NUMPTS-1)) DO L:=L+1;
{now choose points just inside desired limits}
IF NOT(OVERF) THEN BEGIN
WHILE NOT((XDATAVAL(F)<=HIXUC)AND(XDATAVAL(F)>=LOXUC))AND(L>F) DO F:=F+1;
FIRST:=F;
IF LEFT THEN LWBIC:=F ELSE RWBIC:=F;
END;
IF NOT(OVERL) THEN BEGIN
WHILE NOT((XDATAVAL(L)<=HIXUC)AND(XDATAVAL(L)>=LOXUC))AND(L>F) DO L:=L-1;
LAST:=L;
IF LEFT THEN RWBIC:=L ELSE LWBIC:=L;
END;
IF LEFT THEN BEGIN LWBIC:=F; RWBIC:=L; END
ELSE BEGIN LWBIC:=L; RWBIC:=F END;
END; {PROCEDURE LIMITS}
{*********************** PROCEDURE LABELS **********************************}
PROCEDURE LABELS;
{This procedure writes out the information at the bottom of the plot.}
VAR S:STR30; ST:STR80;
FUNCTION RLTOST(RL:REAL):STR20;
VAR S:STR20;
BEGIN STR(RL:6:3,S); RLTOST:=S; END;
BEGIN
CLRBOX(0,GETMAXY-24,GETMAXX,GETMAXY,TRUE);
SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
STR(STEPSIZE,S); ST:=CONCAT('File: ',FILENAME,' Stepsize:',S);
IF FILWIDTH<>1 THEN BEGIN
ST:=CONCAT(ST,' Filter:'); STR(FILWIDTH,S);
CASE FILTYPE OF
0: ST:=CONCAT(ST,'MA Width:',S);
1: BEGIN
ST:=CONCAT(ST,'SG Width:',S);
STR(FILDEGREE,S); ST:=CONCAT(ST,' Degree:',S);
IF FILDERIV<>0 THEN BEGIN
STR(FILDERIV,S); ST:=CONCAT(ST,' Derivative:',S);
END;
END; {1}
END; {CASE}
END; {IF}
OUTTEXTXY(3,GETMAXY-21,ST);
ST:=CONCAT('L:',RLTOST(LWBUC),' R:',RLTOST(RWBUC),' B:',RLTOST(BWBUC),
' T:',RLTOST(TWBUC));
IF TRACE THEN ST:=CONCAT(ST,' (x-hair trace mode)');
OUTTEXTXY(3,GETMAXY-11,ST);
END; {PROCEDURE LABELS}
{************************ DUMP_TEXT **************************************}
PROCEDURE DUMP_TEXT;
VAR DUMPNAME :STR20;
LINE1,LINE2,ERR,I:INTEGER;
ANS,C :CHAR;
OUTFILE :TEXT;
BEGIN
LINE1:=GETMAXY-21; LINE2:=GETMAXY-11; DUMPNAME:='QUIT';
SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
REPEAT
CLRBOX(0,GETMAXY-24,GETMAXX,GETMAXY,TRUE); ANS:='Y';
OUTTEXTXY(3,LINE1,CONCAT('This procedure dumps the displayed data ',
'to a text file.'));
MOVETO(3,LINE2);
OUTTEXT(CONCAT('Name of the file (QUIT if none) [',DUMPNAME,']: '));
GRDSTR20(DUMPNAME);
FOR I:=1 TO LENGTH(DUMPNAME) DO DUMPNAME[I]:=UPCASE(DUMPNAME[I]);
CLRBOX(0,GETMAXY-24,GETMAXX,GETMAXY,TRUE);
IF EXISTS(DUMPNAME) AND (DUMPNAME <> 'QUIT') THEN BEGIN
OUTTEXTXY(3,LINE1,CONCAT('File ',DUMPNAME,' already exists.'));
REPEAT
MOVETO(3,LINE2);
OUTTEXT(CONCAT('Overwrite the existing file (Y or N) [',
ANS,']: '));
GRDCHAR(ANS); CLRBOX(0,GETMAXY-24,GETMAXX,GETMAXY,TRUE);
UNTIL ANS IN ['Y','N'];
END; {IF}
IF (DUMPNAME<>'QUIT') AND (ANS='Y') THEN BEGIN
ASSIGN(OUTFILE,DUMPNAME); REWRITE(OUTFILE); ERR:=IORESULT;
IF ERR<>0 THEN BEGIN
OUTTEXTXY(3,LINE1,CONCAT('IO error ',INTTOSTR(ERR)));
OUTTEXTXY(3,LINE2,'Hit any key to continue.');
REPEAT UNTIL KEYPRESSED; C:=READKEY;
IF C=#0 THEN C:=READKEY;
END {IF}
ELSE BEGIN
OUTTEXTXY(3,LINE1,CONCAT('Data is being written to file ',
DUMPNAME,'.'));
I:=FIRST;
REPEAT
WRITELN(OUTFILE,XDATAVAL(I),' ',FILTER(FILDERIV,I));
I:=I+STEPSIZE;
UNTIL (I>LAST);
END; {ELSE}
CLOSE(OUTFILE);
END; {IF}
UNTIL ANS='Y';
END;
{**************************** SCRNDRAW *********************************}
PROCEDURE SCRNDRAW(ELIPSFLAG:BOOLEAN; STEPSIZE:INTEGER);
{This procedure plots the data or a function on the screen.}
VAR I,XSC,YSC,START :INTEGER;
X :DOUBLE;
INRANGE :BOOLEAN;
BEGIN
SETWRITEMODE(COPYPUT); {overlap with existing stuff}
START:=FIRST; I:=FIRST;
REPEAT
X:=XDATAVAL(I); XSC:=XCOORDSC(X); YSC:=YCOORDSC(FILTER(FILDERIV,I));
IF (XSC>SCRLEFT)AND(XSC<GETMAXX)AND(YSC>SCRTOP)AND
(YSC<(GETMAXY-SCRBOTTOM)) THEN INRANGE:=TRUE
ELSE BEGIN INRANGE:=FALSE; START:=I+1; END;
IF (I=START) OR NOT(INRANGE) THEN MOVETO(XSC,YSC);
IF INRANGE THEN BEGIN
IF (I<>START) AND LINEFLAG THEN LINETO(XSC,YSC);
IF ELIPSFLAG THEN CIRCLE(XSC,YSC,1);
END;
I:=I+STEPSIZE;
UNTIL I>LAST;
SETWRITEMODE(XORPUT); {erase if overlap}
END; {SCRNDRAW}
{************************ PROCEDURE CHANGEFILTER ***********************}
PROCEDURE CHANGEFILTER;
BEGIN
SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
CLRBOX(0,0,GETMAXX,24,TRUE);
MOVETO(3,LINE1);
OUTTEXT(CONCAT('Size of steps between displayed data points [',
INTTOSTR(STEPSIZE),']: ')); GRDINT(STEPSIZE);
REPEAT
MOVETO(3,LINE2);
OUTTEXT(CONCAT('Type of filter: 0-Moving Avg, 1-Savitzky Golay [',
INTTOSTR(FILTYPE),']: ')); GRDINT(FILTYPE);
CLRBOX(0,0,GETMAXX,24,TRUE);
UNTIL FILTYPE=0;
MOVETO(3,LINE1);
OUTTEXT(CONCAT('Width of filter [',inttostr(filwidth),']: '));
GRDINT(FILWIDTH);
REDRAW:=TRUE;
END;
{************************ PROCEDURE TRANSX ***************************}
PROCEDURE TRANSX;
VAR
ANS : CHAR;
I : INTEGER;
SLOPE,INT : REAL;
OLDSLOPE,OLDINT : REAL;
BEGIN
SLOPE:=1; INT:=0; ANS:='N';
SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
REPEAT
CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1);
OUTTEXT(CONCAT('Linear transform of x axis (Y or N) [',ans,']? '));
GRDCHAR(ANS);
UNTIL ANS IN ['Y','y', 'N','n'];
IF ANS IN ['Y','y'] THEN BEGIN
REPEAT
OLDSLOPE:=SLOPE; OLDINT:=INT;
CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1);
OUTTEXT(CONCAT('Slope [',RLTOSTR(slope,15),']: ')); GRDREAL(SLOPE);
MOVETO(3,LINE2);
OUTTEXT(CONCAT('Intercept [',RLTOSTR(INT,15),']: ')); GRDREAL(INT);
UNTIL ((OLDSLOPE=SLOPE) AND (INT=OLDINT));
IF ((SLOPE<>1) OR (INT<>0)) THEN BEGIN
FOR I:=1 TO NUMPTS DO DATA[1,I]:=SLOPE*DATA[1,I]+INT;
MINX:=SLOPE*MINX+INT; MAXX:=SLOPE*MAXX+INT;
IF CHFLAG THEN BEGIN
CHXUC:=SLOPE*CHXUC+INT; CHXSC:=XCOORDSC(CHXUC);
END;
IF LINFLAG THEN BEGIN
LINXUC:=SLOPE*CHXUC+INT; LINXSC:=XCOORDSC(LINXUC);
END;
END; {IF}
END; {IF}
END; {PROCEDURE TRANSX}
{************************ PROCEDURE TRANSY ***************************}
PROCEDURE TRANSY;
VAR
ANS : CHAR;
I : INTEGER;
SLOPE,INT : REAL;
OLDSLOPE,OLDINT : REAL;
BEGIN
SLOPE:=1; INT:=0; ANS:='N';
SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
REPEAT
CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1);
OUTTEXT(CONCAT('Linear transform of y axis (Y or N) [',ans,']? '));
GRDCHAR(ANS);
UNTIL ANS IN ['Y','y', 'N','n'];
IF ANS IN ['Y','y'] THEN BEGIN
REPEAT
OLDSLOPE:=SLOPE; OLDINT:=INT;
CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1);
OUTTEXT(CONCAT('Slope [',RLTOSTR(slope,15),']: ')); GRDREAL(SLOPE);
MOVETO(3,LINE2);
OUTTEXT(CONCAT('Intercept [',RLTOSTR(INT,15),']: ')); GRDREAL(INT);
UNTIL ((OLDSLOPE=SLOPE) AND (INT=OLDINT));
IF ((SLOPE<>1) OR (INT<>0)) THEN BEGIN
FOR I:=1 TO NUMPTS DO DATA[2,I]:=SLOPE*DATA[2,I]+INT;
TWBUC:=TWBUC*SLOPE+INT; BWBUC:=BWBUC*SLOPE+INT;
LOY:=SLOPE*LOY+INT; HIY:=SLOPE*HIY+INT;
IF CHFLAG THEN BEGIN
CHYUC:=SLOPE*CHYUC+INT; CHYSC:=YCOORDSC(CHYUC);
END;
IF LINFLAG THEN BEGIN
LINYUC:=SLOPE*LINYUC+INT; LINYSC:=YCOORDSC(LINYUC);
END;
END; {IF}
END; {IF}
END; {PROCEDURE TRANSY}
{************************ PROCEDURE CONV *****************************}
PROCEDURE CONV(ANG:BOOLEAN);
VAR ANS:CHAR; I:INTEGER;
BEGIN
ANS:='N';
SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
REPEAT
CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1);
IF ANG THEN
OUTTEXT(CONCAT('Angstrom to cm-1 conversion (Y or N) [',ans,']? '))
ELSE OUTTEXT(CONCAT('cm-1 to Angstrom conversion (Y or N) [',ans,']? '));
GRDCHAR(ANS);
UNTIL ANS IN ['Y','y', 'N','n'];
IF ANS IN ['Y','y'] THEN BEGIN
IF ANG THEN BEGIN {Angstroms to cm-1}
FOR I:=1 TO NUMPTS DO DATA[1,I]:=A_TO_CM(DATA[1,I]);
XLABEL:='cm-1';
IF CHFLAG THEN BEGIN
CHXUC:=A_TO_CM(CHXUC); CHXSC:=XCOORDSC(CHXUC);
END;
IF LINFLAG THEN BEGIN
LINXUC:=A_TO_CM(LINXUC); LINXSC:=XCOORDSC(LINXUC);
END;
MINX:=A_TO_CM(MINX); MAXX:=A_TO_CM(MAXX);
END
ELSE BEGIN {cm-1 to Angstroms}
FOR I:=1 TO NUMPTS DO DATA[1,I]:=CM_TO_A(DATA[1,I]);
XLABEL:='Angstroms';
IF CHFLAG THEN BEGIN
CHXUC:=CM_TO_A(CHXUC); CHXSC:=XCOORDSC(CHXUC);
END;
IF LINFLAG THEN BEGIN
LINXUC:=CM_TO_A(LINXUC); LINXSC:=XCOORDSC(LINXUC);
END;
MINX:=CM_TO_A(MINX); MAXX:=CM_TO_A(MAXX);
END; {ELSE}
END; {IF}
END;
{************************ PROCEDURE CHNG_LABELS **********************}
PROCEDURE CHNG_LABELS;
BEGIN
SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
CLRBOX(0,0,GETMAXX,24,TRUE);
MOVETO(3,LINE1); OUTTEXT(CONCAT('X axis label [',XLABEL,']? '));
GRDSTR40(XLABEL);
MOVETO(3,LINE2); OUTTEXT(CONCAT('Y axis label [',YLABEL,']? '));
GRDSTR40(YLABEL);
END;
{************************ PROCEDURE SETLIM ***************************}
PROCEDURE SETLIM; {Manual setting of window limits.}
BEGIN
SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
CLRBOX(0,0,GETMAXX,24,TRUE);
MOVETO(3,LINE1); OUTTEXT(CONCAT('Left [',RLTOSTR(LWBUC,15),']? '));
GRDREAL(LWBUC);
MOVETO(3,LINE2); OUTTEXT(CONCAT('Right [',RLTOSTR(RWBUC,15),']? '));
GRDREAL(RWBUC);
CLRBOX(0,0,GETMAXX,24,TRUE);
MOVETO(3,LINE1); OUTTEXT(CONCAT('Bottom [',RLTOSTR(BWBUC,15),']? '));
GRDREAL(BWBUC);
MOVETO(3,LINE2); OUTTEXT(CONCAT('Top [',RLTOSTR(TWBUC,15),']? '));
GRDREAL(TWBUC);
REDRAW:=TRUE;
END;
{************************ PROCEDURE ZOOMOUT **************************}
PROCEDURE ZOOMOUT;
VAR AMOUNT:REAL;
BEGIN
SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
CLRBOX(0,0,GETMAXX,24,TRUE);
AMOUNT:=ABS(RWBUC-LWBUC)/2; MOVETO(3,LINE1);
OUTTEXT('Expand window horizontally by how many');
MOVETO(3,LINE2);
OUTTEXT(CONCAT('units on each side [',RLTOSTR(AMOUNT,15),']? '));
GRDREAL(AMOUNT);
IF RWBUC>LWBUC THEN AMOUNT:=ABS(AMOUNT) ELSE AMOUNT:=-ABS(AMOUNT);
LWBUC:=LWBUC-AMOUNT; RWBUC:=RWBUC+AMOUNT;
REDRAW:=TRUE;
END;
{*********************** PROCEDURE PAN ******************************}
PROCEDURE PAN(S:STR20);
VAR AMOUNT:REAL;
BEGIN
SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
CLRBOX(0,0,GETMAXX,24,TRUE);
AMOUNT:=ABS(RWBUC-LWBUC)/2; MOVETO(3,LINE1);
OUTTEXT(CONCAT('Pan ',S,' how many units [',RLTOSTR(AMOUNT,15),']? '));
GRDREAL(AMOUNT);
AMOUNT:=ABS(AMOUNT);
IF (RWBUC>LWBUC) AND (S='left') THEN AMOUNT:=-AMOUNT;
IF (RWBUC<LWBUC) AND (S='right') THEN AMOUNT:=-AMOUNT;
LWBUC:=LWBUC+AMOUNT; RWBUC:=RWBUC+AMOUNT;
REDRAW:=TRUE;
END;
{************************ PROCEDURE POST *****************************}
PROCEDURE POST;
VAR ANS :CHAR;
I,J,ERR,MAXX,MAXY :INTEGER;
DUMPNAME :STR20;
OUTFILE :TEXT;
INDEX,VALUE :BYTE;
BEGIN
ANS:='N'; MAXX:=GETMAXX; MAXY:=GETMAXY;
DUMPNAME:=FILENAME; I:=POS('.',FILENAME);
IF I<>0 THEN DELETE(DUMPNAME,I,LENGTH(DUMPNAME)-I+1);
DUMPNAME:=CONCAT(DUMPNAME,'.EPS');
SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
REPEAT
CLRBOX(0,0,MAXX,24,TRUE); MOVETO(3,LINE1);
OUTTEXT(CONCAT('Postscript screen dump (Y or N) [',ans,']? '));
GRDCHAR(ANS);
UNTIL ANS IN ['Y','y', 'N','n'];
IF ANS IN ['Y','y'] THEN BEGIN
MOVETO(3,LINE2);
OUTTEXT(CONCAT('Name of the file (QUIT to abort) [',DUMPNAME,']: '));
GRDSTR20(DUMPNAME);
FOR I:=1 TO LENGTH(DUMPNAME) DO DUMPNAME[I]:=UPCASE(DUMPNAME[I]);
CLRBOX(0,0,MAXX,24,TRUE);
IF EXISTS(DUMPNAME) AND (DUMPNAME <> 'QUIT') THEN BEGIN
OUTTEXTXY(3,LINE1,CONCAT('File ',DUMPNAME,' already exists.'));
REPEAT
MOVETO(3,LINE2);
OUTTEXT(CONCAT('Overwrite the existing file (Y or N) [',ANS,']: '));
GRDCHAR(ANS); CLRBOX(0,0,MAXX,24,TRUE);
UNTIL ANS IN ['Y','y','N','n'];
END; {IF}
IF (DUMPNAME='QUIT') THEN ANS:='N';
END; {IF}
CLRBOX(0,0,MAXX,24,FALSE);
IF ANS IN ['Y','y'] THEN BEGIN
ASSIGN(OUTFILE,DUMPNAME); REWRITE(OUTFILE); ERR:=IORESULT;
IF ERR<>0 THEN BEGIN
CLRBOX(0,0,MAXX,24,TRUE);
OUTTEXTXY(3,LINE1,CONCAT('IO error ',INTTOSTR(ERR)));
OUTTEXTXY(3,LINE2,'Hit any key to continue.');
REPEAT UNTIL KEYPRESSED; ANS:=READKEY;
IF ANS=#0 THEN ANS:=READKEY;
END
ELSE BEGIN
IF CHFLAG THEN BEGIN DRAWCH; DRAWCH; END;
IF LINFLAG THEN BEGIN DRAWLN; DRAWLN; END;
WRITELN(OUTFILE,'%!PS-ADOBE-2.0');
WRITELN(OUTFILE,'gsave');
WRITELN(OUTFILE,'/picstr 1 string def');
WRITELN(OUTFILE,'27 756 moveto');
WRITELN(OUTFILE,ROUND(7.5*72),' ',ROUND((MAXY+1)/(MAXX+1)*7.5*72),
' scale');
WRITELN(OUTFILE,'0 -1 rmoveto');
WRITELN(OUTFILE,'currentpoint translate');
WRITELN(OUTFILE,MAXX+1,' ',MAXY+1,' 1');
WRITELN(OUTFILE,'[',MAXX+1,' 0 0 ',-MAXY-1,' 0 ',MAXY+1,']');
WRITELN(OUTFILE,'{ currentfile picstr readhexstring pop }');
WRITELN(OUTFILE,'image');
INDEX:=8; VALUE:=0;
FOR J:=0 TO MAXY DO FOR I:=0 TO MAXX DO BEGIN
IF (J=LINE2+20) AND (I=0) THEN BEGIN
CLRBOX(0,0,MAXX,24,TRUE);
OUTTEXTXY(3,LINE1,CONCAT('Data is being written to file ',
DUMPNAME,'.'));
END;
INDEX:=INDEX-1;
IF GETPIXEL(I,J)<>0 THEN VALUE:=VALUE OR (1 SHL INDEX);
IF INDEX=0 THEN BEGIN
WRITE(OUTFILE,HEX(NOT VALUE)); INDEX:=8; VALUE:=0;
END;
END; {FOR}
IF INDEX<>8 THEN WRITE(OUTFILE,HEX(NOT VALUE));
WRITELN(OUTFILE); WRITELN(OUTFILE,'grestore showpage');
BEEP(200);
END; {ELSE}
CLOSE(OUTFILE);
END; {IF}
CLRBOX(0,0,MAXX,24,FALSE);
IF CHFLAG THEN BEGIN DRAWCH; DRAWCH; END;
IF LINFLAG THEN BEGIN DRAWLN; DRAWLN; END; {crosshair must be drawn first}
END;
{************************ PROCEDURE MINMAX *******************************}
PROCEDURE MINMAX; {Displays min and max x and y values for displayed data.}
VAR I :INTEGER;
X,Y :REAL;
XMIN,XMAX,YMIN,YMAX :REAL;
START :BOOLEAN;
CH :CHAR;
BEGIN
I:=FIRST; START:=TRUE;
REPEAT
X:=XDATAVAL(I); Y:=FILTER(FILDERIV,I);
IF (XCOORDSC(X)>SCRLEFT)AND(XCOORDSC(X)<GETMAXX) THEN
IF START THEN BEGIN
XMIN:=X; XMAX:=X; YMIN:=Y; YMAX:=Y; START:=FALSE;
END
ELSE BEGIN
IF X>XMAX THEN XMAX:=X; IF X<XMIN THEN XMIN:=X;
IF Y>YMAX THEN YMAX:=Y; IF Y<YMIN THEN YMIN:=Y;
END;
I:=I+STEPSIZE;
UNTIL I>LAST;
SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1);
OUTTEXT(CONCAT('x: Min=',RLTOSTR(XMIN,15),' Max=',RLTOSTR(XMAX,15)));
MOVETO(3,LINE2);
OUTTEXT(CONCAT('y: Min=',RLTOSTR(YMIN,15),' Max=',RLTOSTR(YMAX,15),
' <ENTER> to continue'));
REPEAT CH:=READKEY UNTIL CH=CHAR(13);
CLRBOX(0,0,GETMAXX,24,FALSE); MOVETO(3,LINE1);
IF CHFLAG THEN BEGIN DRAWCH; DRAWCH; END;
IF LINFLAG THEN BEGIN DRAWLN; DRAWLN; END; {crosshair must be drawn first}
END; {PROCEDURE MINMAX}
{************************** NONLINEAR ***********************************}
PROCEDURE NONLINEAR(XY:CHAR);
VAR ANS,I,WHICH : INTEGER;
MAX,MIN,VAL : REAL;
FUNCTION CONVERT(X:SINGLE):SINGLE;
CONST XMIN=2.9E-39*100; XMAX=1.7E38/100;
BEGIN
CASE ANS OF
1: IF X<SQRT(XMAX) THEN CONVERT:=SQR(X) ELSE CONVERT:=XMAX;
2: IF ABS(X)>SQR(XMIN) THEN CONVERT:=SQRT(ABS(X)) ELSE CONVERT:=XMIN;
3: IF ABS(X)>0 THEN CONVERT:=LN(ABS(X)) ELSE CONVERT:=-XMAX;
4: IF ABS(X)>0 THEN CONVERT:=LOG(ABS(X)) ELSE CONVERT:=-XMAX;
5: IF ABS(X)<LN(XMAX) THEN CONVERT:=EXP(X)
ELSE IF X>0 THEN CONVERT:=XMAX
ELSE IF X<0 THEN CONVERT:=0;
6: IF ABS(X)<LOG(XMAX) THEN CONVERT:=EXP(X*LN(10))
ELSE IF X>0 THEN CONVERT:=XMAX
ELSE IF X<0 THEN CONVERT:=0;
ELSE CONVERT:=X;
END; {case}
END; {FUNCTION CONVERT}
BEGIN
RESTORECRTMODE;
ANS:=0; WHICH:=ORD(XY='Y')+1;
WRITELN('Nonlinear transformation of ',xy,' axis.'); WRITELN;
WRITELN('The following transformations are available.');
WRITELN(' 0. None.');
WRITELN(' 1. Sqr(',xy,').');
WRITELN(' 2. Sqrt(|',XY,'|).');
WRITELN(' 3. Ln(|',XY,'|).');
WRITELN(' 4. Log(|',XY,'|).');
WRITELN(' 5. Exp(',XY,').');
WRITELN(' 6. 10^(',XY,').');
WRITE('Select one [',ans,']: '); RDINTLN(OUTPUT,ANS);
IF ANS IN [1..6] THEN BEGIN
MAX:=CONVERT(DATA[WHICH,1]); MIN:=MAX;
FOR I:=1 TO NUMPTS DO BEGIN
VAL:=CONVERT(DATA[WHICH,I]);
IF VAL<MIN THEN MIN:=VAL; IF VAL>MAX THEN MAX:=VAL;
DATA[WHICH,I]:=VAL;
END; {FOR}
MAX:=MAX+ABS(MAX-MIN)/40; MIN:=MIN-ABS(MAX-MIN)/40;
IF XY='X' THEN BEGIN
RWBUC:=MAX; LWBUC:=MIN; MINX:=MIN; MAXX:=MAX;
END
ELSE BEGIN
TWBUC:=MAX; BWBUC:=MIN; LOY:=MIN; HIY:=MAX;
END;
IF CHFLAG THEN
IF XY='X' THEN CHXUC:=CONVERT(CHXUC)
ELSE CHYUC:=CONVERT(CHYUC);
IF LINFLAG THEN
IF XY='X' THEN LINXUC:=CONVERT(LINXUC)
ELSE LINYUC:=CONVERT(LINYUC);
NEWMODE:=TRUE;
END; {IF ANS}
SETGRAPHMODE(GETGRAPHMODE);
REDRAW:=TRUE;
END; {PROCEDURE NONLINEAR}
{************************ PROCEDURE HELP *****************************}
PROCEDURE HELP; {Provides display of key assignments.}
VAR UD,LR:STRING[3];
BEGIN
RESTORECRTMODE;
LR:=CONCAT(CHAR(26),'/',CHAR(27)); UD:=CONCAT(CHAR(24),'/',CHAR(25));
WRITELN(' F1: Crosshair CTRL F1: Ruler');
WRITELN(' F2: Circle points CTRL F2: Connect-the-dots');
WRITELN(' F3: Filter parameters CTRL F3: Integrate');
WRITELN(' F4: Crosshair trace CTRL F4: Labels');
WRITELN(' F5: Dump to file CTRL F5: Postscript screen dump');
WRITELN(' F6: X linear transform CTRL F6: Y linear transform');
WRITELN(' F7: Left/right invert CTRL F7: Top/bottom inversion');
WRITELN(' F8: Angstrom to cm-1 CTRL F8: cm-1 to Angstroms');
WRITELN(' N: X nonlinear transform ALT N: Y nonlinear transform');
WRITELN(' M: Min/max');
WRITELN(' D: DOS command H: Help');
WRITELN('WINDOW CONTROL:');
WRITELN(' PG UP/PG DN: Faster/slower ',UD,': Expand/contract');
WRITELN(' ',LR,': Horizontal HOME/END: Vertical');
WRITELN(' expand/contract expand/contract');
WRITELN(' CTRL ',LR,': Left/right CTRL ',UD,': Up/down');
WRITELN(' ENTER/+/SPACE: Zoom CTRL ENTER: Original plot');
WRITELN(' L: Limits X: Expand horizontally');
WRITELN(' F9: Pan left F10: Pan right');
WRITELN('CROSSHAIR CONTROL:');
WRITELN(' 7/8: faster/slower 9/0: up/down -/=: left/right');
WRITELN('RULER CONTROL:');
WRITELN(' 3/4: up/down 5/6: Left/right Q/W: Shorter/longer');
WRITELN(' 1/2: rotate E: FWHM position R: Horizontal/vertical');
WRITE(' <ENTER> to continue.'); READLN;
SETGRAPHMODE(GETGRAPHMODE);
REDRAW:=TRUE;
END;
{************************** MAIN PROGRAM *****************************}
BEGIN
{Set up the graphics window.}
CLRSCR; {clear the screen}
GRAPHDRIVER:=0; {autodetect graphics device}
INITGRAPH(GRAPHDRIVER,GRAPHMODE,DRIVERS); ERRCODE:=GRAPHRESULT;
IF ERRCODE<>0 THEN BEGIN
BEEP(200);
WRITELN('Graphics error: ',grapherrormsg(errcode));
WRITE('Hit any key to continue. '); READLN;
END;
IF ERRCODE=0 THEN BEGIN
{Initialize}
FIRST:=1; LAST:=NUMPTS;
BWBUC:=LOY; TWBUC:=HIY; LWBUC:=MINX; RWBUC:=MAXX;
LWBIC:=1; RWBIC:=NUMPTS;
XLABEL:='X'; YLABEL:='Y';
NEWMODE:=FALSE; DONEFLAG:=FALSE; ELIPSFLAG:=FALSE; FRAME:=FALSE;
LINEFLAG:=TRUE; WINDSENS:=20; LINFLAG:=FALSE;
CHFLAG:=FALSE; CHSENS:=20; TRACE:=FALSE;
FILTYPE:=0; FILDEGREE:=2; FILWIDTH:=1; FILDERIV:=0;
STEPSIZE:=1;
{initialize crosshair and line to center of window}
CHXSC:=ROUND((SCRLEFT+GETMAXX)/2);
CHYSC:=ROUND((GETMAXY-SCRBOTTOM+SCRTOP)/2);
LINXSC:=CHXSC; LINYSC:=CHYSC; LINLEN:=30; THETA:=0.0; TRACE:=FALSE;
REPEAT {UNTIL DONEFLAG}
REDRAW:=FALSE;
{initialize window boundaries in screen coords}
LWBSC:=SCRLEFT; RWBSC:=GETMAXX;
BWBSC:=GETMAXY-SCRBOTTOM; TWBSC:=SCRTOP;
{clear window}
CLEARDEVICE; SETWRITEMODE(XORPUT);
IF NEWMODE THEN BEGIN {redefine bounds in new user coords}
NEWMODE:=FALSE; LWBUC:=XDATAVAL(LWBIC); RWBUC:=XDATAVAL(RWBIC);
END; {IF NEWMODE}
{determine min and max x axis values}
IF (RWBUC>LWBUC) THEN BEGIN LOXUC:=LWBUC; HIXUC:=RWBUC; END
ELSE BEGIN LOXUC:=RWBUC; HIXUC:=LWBUC; END;
{determine first and last points}
LIMITS(LOXUC,HIXUC,FIRST,LAST,LWBIC,RWBIC);
{determine screen positions of crosshair and line}
IF (CHXUC>HIXUC) OR (CHXUC<LOXUC) THEN CHXSC:=ROUND((LWBSC+RWBSC)/2)
ELSE CHXSC:=XCOORDSC(CHXUC);
IF (LINXUC>HIXUC) OR (LINXUC<LOXUC) THEN LINXSC:=CHXSC
ELSE LINXSC:=XCOORDSC(LINXUC);
IF (TWBUC>BWBUC) THEN BEGIN
IF (CHYUC>TWBUC) OR (CHYUC<BWBUC) THEN CHYSC:=ROUND((BWBSC+TWBSC)/2)
ELSE CHYSC:=YCOORDSC(CHYUC);
IF (LINYUC>TWBUC) OR (LINYUC<BWBUC) THEN LINYSC:=CHYSC
ELSE LINYSC:=YCOORDSC(LINYUC);
END
ELSE BEGIN
IF (CHYUC<TWBUC) OR (CHYUC>BWBUC) THEN CHYSC:=ROUND((BWBSC+TWBSC)/2)
ELSE CHYSC:=YCOORDSC(CHYUC);
IF (LINYUC<TWBUC) OR (LINYUC>BWBUC) THEN LINYSC:=CHYSC
ELSE LINYSC:=YCOORDSC(LINYUC);
END;
IF TRACE THEN SETCHY;
{plot the data}
RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
LABELS;
AXIS(LWBUC,RWBUC,BWBUC,TWBUC,LWBSC,RWBSC,BWBSC,TWBSC,XLABEL,YLABEL);
SCRNDRAW(ELIPSFLAG,STEPSIZE);
{overlay the remaining stuff}
IF CHFLAG THEN DRAWCH;
IF LINFLAG THEN DRAWLN; {crosshair must be drawn first}
REPEAT {UNTIL REDRAW OR DONEFLAG}
REPEAT UNTIL KEYPRESSED;
ASCII:=ORD(READKEY);
CASE ASCII OF
0 : BEGIN SCANCODE:=ORD(READKEY);
CASE SCANCODE OF
{F1} 59: BEGIN {toggle crosshair display}
CHFLAG:=NOT CHFLAG;
IF (TRACE AND CHFLAG) THEN SETCHY;
DRAWCH;
END;
{CTRL F1} 94: BEGIN {toggle line on/off}
LINFLAG:=NOT LINFLAG; DRAWLN;
END;
{F2} 60: BEGIN {toggle ellipse display}
REDRAW:=TRUE;
IF ELIPSFLAG THEN ELIPSFLAG:=FALSE ELSE ELIPSFLAG:=TRUE;
IF NOT(ELIPSFLAG OR LINEFLAG) THEN LINEFLAG:=TRUE;
END;
{CTRL F2} 95: BEGIN {toggle connect the dots}
REDRAW:=TRUE;
IF LINEFLAG THEN LINEFLAG:=FALSE ELSE LINEFLAG:=TRUE;
IF NOT(LINEFLAG OR ELIPSFLAG) THEN ELIPSFLAG:=TRUE;
END;
{F3} 61: BEGIN {change filter parameters}
CHANGEFILTER; REDRAW:=TRUE;
END;
{CTRL F3} 96: BEGIN {peak integration}
IF LINFLAG THEN INTEGRATE;
END;
{F4} 62: IF CHFLAG THEN BEGIN {toggle crosshair trace mode}
DRAWCH; {erase existing ch}
TRACE:=NOT TRACE;
IF TRACE THEN SETCHY; DRAWCH; LABELS;
END;
{CTRL F4} 97: BEGIN {change axis labels}
CHNG_LABELS; REDRAW:=TRUE;
END;
{F5} 63: BEGIN {dump displayed data to a file}
DUMP_TEXT; LABELS;
END;
{CTRL F5} 98: POST; {postscript screen dump}
{F6} 64: BEGIN {x axis linear transformation}
TRANSX; NEWMODE:=TRUE; REDRAW:=TRUE;
END;
{CTRL F6} 99: BEGIN {y axis linear transformation}
TRANSY; NEWMODE:=TRUE; REDRAW:=TRUE;
END;
{PG UP - increase window movement sensitivity}
73,132: BEGIN
CASE WINDSENS OF
1: WINDSENS:=2; 2:WINDSENS:=5; 5:WINDSENS:=10;
10: WINDSENS:=20; 20:WINDSENS:=50;
END; {CASE}
BEEP(200*WINDSENS);
END;
{PG DN - decrease window movement sensitivity}
81,118: BEGIN
CASE WINDSENS OF
50:WINDSENS:=20; 20:WINDSENS:=10; 10:WINDSENS:=5;
5:WINDSENS:=2; 2:WINDSENS:=1;
END; {CASE}
BEEP(200*WINDSENS);
END;
{CTRL HOME - translate window up}
119:IF (TWBSC-WINDSENS)>=SCRTOP THEN BEGIN
RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
TWBSC:=TWBSC-WINDSENS; BWBSC:=BWBSC-WINDSENS;
FRAME:=TRUE;
END;
{CTRL END - translate window down}
117:IF (BWBSC+WINDSENS)<=(GETMAXY-SCRBOTTOM) THEN BEGIN
RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
TWBSC:=TWBSC+WINDSENS; BWBSC:=BWBSC+WINDSENS;
FRAME:=TRUE;
END;
{CTRL LEFT ARROW - translate window left}
115:IF (LWBSC-WINDSENS)>=SCRLEFT THEN BEGIN
RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
LWBSC:=LWBSC-WINDSENS; RWBSC:=RWBSC-WINDSENS;
FRAME:=TRUE;
END;
{CTRL RIGHT ARROW - translate window to right}
116:IF (RWBSC+WINDSENS)<=GETMAXX THEN BEGIN
RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
RWBSC:=RWBSC+WINDSENS; LWBSC:=LWBSC+WINDSENS;
FRAME:=TRUE;
END;
{LEFT ARROW - contract window horizontally}
75: IF (RWBSC-LWBSC)>(2*WINDSENS) THEN BEGIN
RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
RWBSC:=RWBSC-WINDSENS; LWBSC:=LWBSC+WINDSENS;
FRAME:=TRUE;
END;
{RIGHT ARROW - expand window horizontally}
77: IF ((LWBSC-WINDSENS)>=SCRLEFT) AND
((RWBSC+WINDSENS)<=GETMAXX) THEN BEGIN
RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
LWBSC:=LWBSC-WINDSENS; RWBSC:=RWBSC+WINDSENS;
FRAME:=TRUE;
END;
{END -contract window vertically}
79: IF (BWBSC-TWBSC)>(2*WINDSENS) THEN BEGIN
RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
TWBSC:=TWBSC+WINDSENS; BWBSC:=BWBSC-WINDSENS;
FRAME:=TRUE;
END;
{HOME - expand window vertically}
71: IF ((BWBSC+WINDSENS)<=GETMAXY) AND
((TWBSC-WINDSENS)>=SCRTOP) THEN BEGIN
RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
BWBSC:=BWBSC+WINDSENS; TWBSC:=TWBSC-WINDSENS;
FRAME:=TRUE;
END;
{UP ARROW - expand window}
72: IF ((BWBSC+WINDSENS)<=GETMAXY) AND
((TWBSC-WINDSENS)>=SCRTOP) AND
((LWBSC-WINDSENS)>=SCRLEFT) AND
((RWBSC+WINDSENS)<=GETMAXX) THEN BEGIN
RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
BWBSC:=BWBSC+WINDSENS; TWBSC:=TWBSC-WINDSENS;
LWBSC:=LWBSC-WINDSENS; RWBSC:=RWBSC+WINDSENS;
FRAME:=TRUE;
END;
{DOWN ARROW - contract window}
80:IF ((RWBSC-LWBSC)>(2*WINDSENS)) AND
((BWBSC-TWBSC)>(2*WINDSENS)) THEN BEGIN
RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
RWBSC:=RWBSC-WINDSENS; LWBSC:=LWBSC+WINDSENS;
TWBSC:=TWBSC+WINDSENS; BWBSC:=BWBSC-WINDSENS;
FRAME:=TRUE;
END;
{F7} 65: BEGIN {left/right inversion}
OLDLWBUC:=LWBUC; LWBUC:=RWBUC; RWBUC:=OLDLWBUC;
REDRAW:=TRUE;
END;
{CTRL F7} 100:BEGIN {top/bottom inversion}
OLDBWBUC:=BWBUC; BWBUC:=TWBUC; TWBUC:=OLDBWBUC;
REDRAW:=TRUE;
END;
{F8} 66: BEGIN {Angstrom to cm-1 conversion}
CONV(TRUE); NEWMODE:=TRUE; REDRAW:=TRUE;
END;
{CTRL F8} 101:BEGIN {cm-1 to Angstrom conversion}
CONV(FALSE); NEWMODE:=TRUE; REDRAW:=TRUE;
END;
{F9} 67: PAN('left');
{F10} 68: PAN('right');
{ALT N} 49: NONLINEAR('Y'); {y axis nonlinear transformation}
END; {CASE}
END;
{ESC} 27: DONEFLAG:=TRUE;
{ENTER, +, or SPACE - zoom}
13,43,32: BEGIN
REDRAW:=TRUE;
OLDLWBUC:=LWBUC; OLDBWBUC:=BWBUC;
LWBUC:=OLDLWBUC+((RWBUC-OLDLWBUC)*((LWBSC-SCRLEFT)/
(GETMAXX-SCRLEFT)));
RWBUC:=OLDLWBUC+((RWBUC-OLDLWBUC)*((RWBSC-SCRLEFT)/
(GETMAXX-SCRLEFT)));
BWBUC:=OLDBWBUC+(TWBUC-OLDBWBUC)*(BWBSC-GETMAXY+SCRBOTTOM)/
(SCRTOP-GETMAXY+SCRBOTTOM);
TWBUC:=OLDBWBUC+(TWBUC-OLDBWBUC)*(TWBSC-GETMAXY+SCRBOTTOM)/
(SCRTOP-GETMAXY+SCRBOTTOM);
END;
{0} 48: {crosshair up}
IF CHFLAG AND ((CHYSC-CHSENS)>=SCRTOP) THEN BEGIN
DRAWCH; CHYSC:=CHYSC-CHSENS; DRAWCH;
END;
{9} 57: {crosshair down}
IF CHFLAG AND ((CHYSC+CHSENS)<=(GETMAXY-SCRBOTTOM)) THEN BEGIN
DRAWCH; CHYSC:=CHYSC+CHSENS; DRAWCH;
END;
{=} 61: {crosshair right}
IF CHFLAG AND ((CHXSC+CHSENS)<=GETMAXX) THEN BEGIN
DRAWCH; CHXSC:=CHXSC+CHSENS; IF TRACE THEN SETCHY; DRAWCH;
END;
{-} 45: {crosshair left}
IF CHFLAG AND ((CHXSC-CHSENS)>=SCRLEFT) THEN BEGIN
DRAWCH; CHXSC:=CHXSC-CHSENS; IF TRACE THEN SETCHY; DRAWCH;
END;
{8} 56: BEGIN {increase crosshair sensitivity}
CASE CHSENS OF
1 :CHSENS:=2; 2:CHSENS:=5; 5:CHSENS:=10;
10:CHSENS:=20; 20:CHSENS:=50;
END; {CASE}
BEEP(200*CHSENS);
END;
{7} 55: BEGIN {decrease crosshair sensitivity}
CASE CHSENS OF
50:CHSENS:=20; 20:CHSENS:=10; 10:CHSENS:=5;
5:CHSENS:=2; 2:CHSENS:=1;
END; {CASE}
BEEP(200*CHSENS);
END;
{line} 49,50,51,52,53,54,81,87,82,69,113,119,101,114:
IF LINFLAG THEN BEGIN
DRAWLN;
CASE ASCII OF
{1} 49:BEGIN {rotate counterclockwise}
THETA:=THETA+CHSENS/LINLEN*2;
THETA:=THETA-TRUNC(THETA/(2*PI))*2*PI;
END;
{2} 50:BEGIN {rotate line clockwise}
THETA:=THETA-CHSENS/LINLEN*2;
THETA:=THETA-TRUNC(THETA/(2*PI))*2*PI;
END;
{3} 51:LINYSC:=LINYSC+CHSENS; {translate line down}
{4} 52:LINYSC:=LINYSC-CHSENS; {translate line up}
{5} 53:LINXSC:=LINXSC-CHSENS; {translate line to left}
{6} 54:LINXSC:=LINXSC+CHSENS; {translate line to right}
{Q} 81,113:LINLEN:=ABS(LINLEN-CHSENS); {shorten line}
{W} 87,119:LINLEN:=ABS(LINLEN+CHSENS); {lengthen line}
{E} 69,101:IF CHFLAG THEN BEGIN {move line to FWHM position}
LINYSC:=ROUND((CHYSC+LINYSC+TAN(THETA)*(CHXSC-LINXSC))/2);
LINXSC:=CHXSC;
END;
{R} 82,114:IF THETA=0 THEN THETA:=PI/2 {vertical/horizontal}
ELSE THETA:=0;
END; {CASE}
DRAWLN;
END; {IF LINFLAG}
{H} 72,104: HELP;
{L} 76,108: SETLIM; {user specified window bounds}
{M} 77,109: MINMAX; {max and min of displayed data}
{N} 78,110: NONLINEAR('X'); {x axis nonlinear transform}
{X} 88,120: ZOOMOUT; {zoom out horizontally}
{D} 68,100: BEGIN {execute a DOS command}
RESTORECRTMODE; DOS_CMD; SETGRAPHMODE(GETGRAPHMODE);
REDRAW:=TRUE;
END;
{CTRL ENTER - return to original plot}
10: BEGIN
REDRAW:=TRUE;
FIRST:=1; LAST:=NUMPTS;
BWBUC:=LOY; TWBUC:=HIY; LWBUC:=MINX; RWBUC:=MAXX;
END;
END; {CASE}
IF FRAME THEN BEGIN
RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC); FRAME:=FALSE;
END;
UNTIL REDRAW OR DONEFLAG;
UNTIL DONEFLAG;
END; {IF}
CLOSEGRAPH;
END; {GRAF}
END. {UNIT}